home *** CD-ROM | disk | FTP | other *** search
/ MacGames Sampler / PHT MacGames Bundle.iso / MacSource Folder / Samples from the CD / Pascal / Source□ / Talk Source / My Libraries / MyOOMainLoop.p < prev    next >
Encoding:
Text File  |  1992-04-20  |  22.5 KB  |  905 lines  |  [TEXT/PJMM]
  1. unit OOMainLoop;
  2.  
  3. { This program was written by Peter N Lewis, Mar 1992 in THINK Pascal 4.0.1 }
  4.  
  5. interface
  6.  
  7.     const
  8.         WT_NotMine = 'NtMe';
  9.         WT_Generic = 'Genr';
  10.  
  11.     type
  12.         SCType = (SCSave, SCCancel, SCDiscard);
  13.         WObject = object
  14.                 window: dialogPtr;
  15.                 resid: integer;
  16.                 window_type: OSType;
  17.                 growRect: rect; { minimum/maximum rect size (for use with grow window) }
  18.                 zoomSize: point; { Optimum zoom size }
  19.                 draw_grow_icon: boolean;
  20.                 is_active: boolean;
  21.                 procedure Create (id: integer);
  22.                 procedure Destroy;
  23.                 procedure GetWindowPos (h: handle);
  24.                 procedure SetWindowPos (h: handle; var wasvisible: boolean);
  25.                 function SaveChanges: SCType;
  26.                 procedure DoClose;
  27. { DoClose checks modified things etc, then calls Destroy }
  28.                 function SetMenuBar: boolean;
  29.                 function EditMenuEnabled: boolean;
  30.                 procedure SetEditMenuItem (item: integer);
  31.                 procedure DoEditMenu (item: integer);
  32.                 function DoMenuKey (er: eventRecord; ch: char): longInt;
  33.                 procedure CalculateRegion (var rgn: rgnHandle);
  34.                 function WaitForEvent (var er: eventRecord; sleep: longInt): boolean;
  35.                 procedure DoIdle;
  36.                 procedure DoDiskEvent (message: longInt);
  37.                 procedure DoSuspendResume (resume: boolean);
  38.                 procedure DoHighLevel (er: eventRecord);
  39.                 procedure DoContent (where: point);
  40.                 procedure DoKey (modifiers: integer; ch: char; code: integer);
  41.                 procedure DoSpecialKey (modifiers: integer; ch: char; code: integer);
  42.                 procedure DoAutoKey (modifiers: integer; ch: char; code: integer);
  43.                 procedure DoDrag (where: point);
  44.                 procedure DoGrow (where: point);
  45.                 procedure Zoom (code: integer);
  46.                 procedure DoZoom (where: point; code: integer);
  47.                 procedure DoGoAway (where: point);
  48.                 procedure DoUpdate;
  49.                 procedure DoMouseMoved (where: point);
  50.                 procedure DoActivateDeactivate (activate: boolean);
  51.                 procedure Resize;
  52.                 procedure Draw;
  53.                 function DoMainClick (er: eventRecord): boolean;
  54.                 function DoIsDialogEvent (er: eventRecord): boolean;
  55.                 function DoDialogSelect (er: eventRecord; var dlg: dialogPtr; var item: integer): boolean;
  56.                 function HandleEvents (er: eventRecord): boolean;
  57.             end;
  58.         DObject = object(WObject)
  59.                 ok_item, cancel_item: integer;
  60.                 handle_activate_outline: boolean;
  61.                 procedure Create (id: integer);
  62.                 override;
  63.                 procedure Destroy;
  64.                 override;
  65.                 procedure SetOOOutline (def_item, user_item: integer);
  66.                 procedure DObject.DoActivateDeactivate (activate: boolean);
  67.                 override;
  68.                 function HandleEvents (er: eventRecord): boolean;
  69.                 override;
  70.                 procedure DoItem (item: integer);
  71.                 procedure DoItemWhere (er: eventRecord; item: integer);
  72.                 procedure DoCancel (modifiers: integer; ch: char; code: integer);
  73.                 procedure DoOK (modifiers: integer; ch: char; code: integer);
  74.             end;
  75.         DTObject = object(DObject)
  76.                 procedure SetEditMenuItem (item: integer);
  77.                 override;
  78.                 function EditMenuEnabled: boolean;
  79.                 override;
  80.                 procedure DoEditMenu (item: integer);
  81.                 override;
  82.                 function DoIsDialogEvent (er: eventRecord): boolean;
  83.                 override;
  84.             end;
  85.  
  86.     var
  87.         default_object: WObject;
  88.  
  89.     function GetWType (wp: windowPtr): OSType;
  90.     function GetWObject (wp: windowPtr): WObject;
  91.     function GetDObject (dlg: dialogPtr): DObject;
  92.     function FrontObject: WObject;
  93.     function IsWObjectFront (o: WObject): boolean;
  94.     procedure InitMainLoop (dobj: DObject; domenu: procptr);
  95. { dobj will be used returned with window set to wp whenever GetWObject/GetDObject is called with a DA or nil window }
  96.     procedure FinishMainLoop;
  97. {    procedure DoMenu (themenu, theitem: integer);}
  98.  
  99. implementation
  100.  
  101.     uses
  102.         Script, MyUtils, MyUtilities, MyTypes, MyFMenus, BaseGlobals, MyTEUtils, MyAssertions, MyDialogs;
  103.  
  104.     const
  105.         titlebar_hight = 18;
  106.  
  107.     type
  108.         WStateDataPtr = ^WStateData;
  109.         WStateDataHandle = ^WStateDataPtr;
  110.  
  111.     const
  112. { from EPPC }
  113.         kHighLevelEvent = 23;
  114.         OOMagic = 'MyOO';
  115.  
  116.     type
  117.         myWindowRecord = record
  118.                 thewindow: windowRecord;
  119.                 magic: OSType;
  120.             end;
  121.         myWindowPtr = ^myWindowRecord;
  122.         myDialogRecord = record
  123.                 thedialog: dialogRecord;
  124.                 magic: OSType;
  125.             end;
  126.         myDialogPtr = ^myDialogRecord;
  127.  
  128. { from AppleEvents }
  129.     function AEProcessAppleEvent (theEventRecord: EventRecord): OSErr;
  130.     inline
  131.         $303C, $021B, $A816;
  132.  
  133.     var
  134.         domenup: procptr;
  135.  
  136.     procedure DoMenu (themenu, theitem: integer; domenu: procptr);
  137.     inline
  138.         $205F, $4E90;
  139.  
  140. {$S Init}
  141.     procedure InitMainLoop (dobj: DObject; domenu: procptr);
  142.         var
  143.             i: integer;
  144.             dummy: boolean;
  145.             dummy_er: eventRecord;
  146.     begin
  147.         for i := 1 to 5 do
  148.             dummy := EventAvail(everyEvent, dummy_er);
  149.         domenup := domenu;
  150.         default_object := dobj;
  151.     end;
  152.  
  153. {$S Term}
  154.     procedure FinishMainLoop;
  155.     begin
  156.         dispose(default_object);
  157.     end;
  158.  
  159. {$S}
  160.     function GetWRC (wp: windowPtr): WObject;
  161.         var
  162.             rc: longInt;
  163.     begin
  164.         if wp = nil then
  165.             rc := 0
  166.         else if windowPeek(wp)^.windowKind < 0 then
  167.             rc := 0
  168.         else if windowPeek(wp)^.windowKind = dialogKind then
  169.             if myDialogPtr(wp)^.magic = OOMagic then
  170.                 rc := GetWRefCon(wp)
  171.             else
  172.                 rc := 0
  173.         else if myWindowPtr(wp)^.magic = OOMagic then
  174.             rc := GetWRefCon(wp)
  175.         else
  176.             rc := 0;
  177.         if rc = 0 then begin
  178.             default_object.window := wp;
  179.             rc := longInt(default_object);
  180.         end;
  181.         GetWRC := WObject(rc);
  182.     end;
  183.  
  184.     function GetWType (wp: windowPtr): OSType;
  185.         var
  186.             wo: WObject;
  187.     begin
  188.         wo := GetWRC(wp);
  189.         if wo = default_object then
  190.             GetWType := WT_NotMine
  191.         else
  192.             GetWType := wo.window_type;
  193.     end;
  194.  
  195.     function GetWObject (wp: windowPtr): WObject;
  196.     begin
  197.         GetWObject := GetWRC(wp);
  198.     end;
  199.  
  200.     function GetDObject (dlg: dialogPtr): DObject;
  201.     begin
  202.         GetDObject := DObject(GetWRC(dlg));
  203.     end;
  204.  
  205.     function FrontObject: WObject;
  206.     begin
  207.         FrontObject := GetWRC(FrontWindow);
  208.     end;
  209.  
  210.     function IsWObjectFront (o: WObject): boolean;
  211.     begin
  212.         if o = nil then
  213.             IsWObjectFront := false
  214.         else if o.window = nil then
  215.             IsWObjectFront := false
  216.         else
  217.             IsWObjectFront := o.window = FrontWindow;
  218.     end;
  219.  
  220.     function WObject.SaveChanges: SCType;
  221.         var
  222.             a: integer;
  223.             title: str255;
  224.     begin
  225.         SelectWindow(window);
  226.         GetWTitle(window, title);
  227.         if quitNow then
  228.             ParamText(title, GetGlobalString(quiting_str), '', '')
  229.         else
  230.             ParamText(title, GetGlobalString(closing_str), '', '');
  231.         SetCursor(arrow);
  232.         a := Alert(save_changes_alert_id, nil);
  233.         SaveChanges := SCType(a - 1);
  234.     end;
  235.  
  236.     function WObject.EditMenuEnabled: boolean;
  237.     begin
  238.         if window = nil then
  239.             EditMenuEnabled := false
  240.         else
  241.             EditMenuEnabled := windowPeek(window)^.windowKind < 0
  242.     end;
  243.  
  244.     function WObject.SetMenuBar: boolean;
  245.         var
  246.             oldEditEnabled, editEnabled: boolean;
  247.     begin
  248.         oldEditEnabled := GetIDItemEnable(M_Edit, 0);
  249.         editEnabled := FrontObject.EditMenuEnabled;
  250.         if editEnabled <> oldEditEnabled then
  251.             SetIDItemEnable(M_Edit, 0, editEnabled);
  252.         SetMenuBar := editEnabled <> oldEditEnabled;
  253.     end;
  254.  
  255.     procedure WObject.SetEditMenuItem (item: integer);
  256.     begin
  257.     end;
  258.  
  259.     procedure WObject.DoEditMenu (item: integer);
  260.         var
  261.             dummyb: boolean;
  262.     begin
  263.         if item <= 6 then
  264.             dummyb := SystemEdit(item - 1);
  265.     end;
  266.  
  267.     function WObject.DoMenuKey (er: eventRecord; ch: char): longInt;
  268.         const
  269.             kMaskVirtualKey = $0000FF00; {get virtual key from event message}
  270.             kMaskASCII1 = $00FF0000;
  271.             kMaskASCII2 = $000000FF; {get key from KeyTrans return}
  272.             kKeyUpMask = $0080;
  273.         var
  274.             h: handle;
  275.             virtualKey, keyCId, state, keyInfo: longInt;
  276.             keycode: integer;
  277.             lowchar, highchar: integer;
  278.     begin
  279.         if BAND(er.modifiers, optionKey) <> 0 then begin
  280.             virtualKey := BSR(BAND(er.message, kMaskVirtualKey), 8);
  281.             keyCode := BOR(BOR(BXOR(er.modifiers, optionKey), kKeyUpMask), virtualKey);
  282.             state := 0;
  283.  
  284.             keyCId := GetScript(GetEnvirons(smKeyScript), smScriptKeys);
  285.             h := GetResource('KCHR', keyCId);
  286.  
  287.             if h <> nil then begin
  288. { we don't need to lock the resource since KeyTrans}
  289. {    will not move memory }
  290.                 keyInfo := KeyTrans(h^, keyCode, state);
  291.                 ReleaseResource(h);
  292.                 LowChar := BAND(keyInfo, $FF);
  293.                 HighChar := BAND(BSR(keyInfo, 16), $FF);
  294.                 if lowChar <> 0 then
  295.                     ch := chr(lowChar);
  296.                 if highChar <> 0 then
  297.                     ch := chr(highChar);
  298.             end;
  299.         end;
  300.         DoMenuKey := MenuKey(ch);
  301.     end;
  302.  
  303.     procedure WObject.CalculateRegion (var rgn: rgnHandle);
  304.     begin
  305.         SetCursor(arrow);
  306.         rgn := nil;
  307.     end;
  308.  
  309.     function WObject.WaitForEvent (var er: eventRecord; sleep: longInt): boolean;
  310.         var
  311.             rgn: rgnHandle;
  312.             b: boolean;
  313.     begin
  314.         CalculateRegion(rgn);
  315.         WaitForEvent := WaitGetNextEvent(everyEvent, er, sleep, rgn);
  316.         if rgn <> nil then
  317.             DisposeRgn(rgn);
  318.     end;
  319.  
  320.     procedure WObject.DoDiskEvent (message: longInt);
  321.         var
  322.             pt: point;
  323.             oe: OSErr;
  324.     begin
  325.         if (HiWord(message) <> noErr) then begin
  326.             pt.h := ((screenbits.bounds.Right - screenbits.bounds.Left - 304) div 2);
  327.             pt.v := ((screenbits.bounds.Bottom - screenbits.bounds.Top - 156) div 3);
  328.             InitCursor;
  329.             oe := DIBadMount(pt, message);
  330.         end;
  331.     end;
  332.  
  333.     procedure WObject.DoSuspendResume (resume: boolean);
  334.     begin
  335.         in_foreground := resume;
  336.         if FrontWindow <> nil then begin
  337.             FrontObject.DoActivateDeactivate(resume);
  338.         end;
  339.         InitCursor;
  340.     end;
  341.  
  342.     procedure WObject.DoHighLevel (er: eventRecord);
  343.         var
  344.             oe: OSErr;
  345.     begin
  346.         if has_AppleEvents then
  347.             oe := AEProcessAppleEvent(er);
  348.     end;
  349.  
  350.     procedure JointCreate (o: WObject; id: integer);
  351.     begin
  352.         SetWRefCon(o.window, longInt(o));
  353.         o.growRect := GetGrayRgn^^.rgnBBox;
  354.         o.growRect.left := 61;
  355.         o.growRect.top := 61;
  356.         o.zoomSize.h := 30000;
  357.         o.zoomSize.v := 30000;
  358.         o.window_type := WT_Generic;
  359.         o.draw_grow_icon := false;
  360.         o.resid := id;
  361.     end;
  362.  
  363.     procedure WObject.Create (id: integer);
  364.         var
  365.             wp: myWindowPtr;
  366.     begin
  367.         wp := myWindowPtr(NewPtr(SizeOf(myWindowRecord)));
  368.         wp^.magic := OOMagic;
  369.         window := GetNewWindow(id, ptr(wp), POINTER(-1));
  370.         JointCreate(self, id);
  371.     end;
  372.  
  373.     procedure WObject.Destroy;
  374.     begin
  375.         if window <> nil then
  376.             DisposeWindow(window);
  377.         if self <> default_object then
  378.             dispose(self);
  379.     end;
  380.  
  381.     type
  382.         savedWindowRecord = record
  383.                 windowpos: rect; { the window position }
  384.                 windowvis: rect; { the visible part of the title bar }
  385.                 zoomed: boolean;
  386.                 visible: boolean;
  387.             end;
  388.         savedWindowPtr = ^savedWindowRecord;
  389.         savedWindowHandle = ^savedWindowPtr;
  390.  
  391.     procedure WObject.GetWindowPos (h: handle);
  392.         var
  393.             rgn: RgnHandle;
  394.     begin
  395.         SetHandleSize(h, SizeOf(savedWindowRecord));
  396.         HLock(h);
  397.         with savedWindowHandle(h)^^ do begin
  398.             visible := windowPeek(window)^.visible;
  399.             windowpos := window^.portRect;
  400.             OffsetRect(windowpos, -window^.portBits.bounds.left, -window^.portBits.bounds.top);
  401.             windowpos.top := windowpos.top - titlebar_hight; { title bar }
  402.             rgn := NewRgn;
  403.             RectRgn(rgn, windowpos);
  404.             SectRgn(GetGrayRgn, rgn, rgn);
  405.             windowvis := rgn^^.rgnBBox;
  406.             DisposeRgn(rgn);
  407.             zoomed := false;
  408.         end;
  409.         HUnlock(h);
  410.     end;
  411.  
  412.     procedure WObject.SetWindowPos (h: handle; var wasvisible: boolean);
  413.         var
  414.             rgn: RgnHandle;
  415.             r: rect;
  416.             dummy: boolean;
  417.     begin
  418.         if (h <> nil) & (GetHandleSize(h) = SizeOf(savedWindowRecord)) then begin
  419.             HLock(h);
  420.             with savedWindowHandle(h)^^ do begin
  421.                 wasvisible := visible;
  422.                 rgn := NewRgn;
  423.                 RectRgn(rgn, windowvis);
  424.                 SectRgn(GetGrayRgn, rgn, rgn);
  425.                 r := rgn^^.rgnBBox;
  426.                 DisposeRgn(rgn);
  427.                 dummy := SectRect(r, windowvis, r);
  428.                 if (longInt(r.topleft) = longInt(windowvis.topleft)) & (longInt(r.botright) = longInt(windowvis.botright)) then begin
  429.                     with windowpos do begin
  430.                         MoveWindow(window, left, top + titlebar_hight, true);
  431.                         SizeWindow(window, right - left, bottom - top - titlebar_hight, true);
  432.                     end;
  433.                 end;
  434.                 if zoomed then
  435.                     Zoom(inZoomOut)
  436.                 else
  437.                     Resize;
  438.             end;
  439.             HUnlock(h);
  440.         end
  441.         else
  442.             wasvisible := true;
  443.     end;
  444.  
  445.     procedure WObject.DoClose;
  446.     begin
  447.         Destroy;
  448.     end;
  449.  
  450.     procedure WObject.DoContent (where: point);
  451.     begin
  452.     end;
  453.  
  454.     procedure WObject.DoKey (modifiers: integer; ch: char; code: integer);
  455.     begin
  456.         SysBeep(1);
  457.     end;
  458.  
  459.     procedure WObject.DoSpecialKey (modifiers: integer; ch: char; code: integer);
  460.         var
  461.             item: integer;
  462.     begin
  463.         case code of
  464.             undoKey: 
  465.                 item := EMundo;
  466.             cutKey: 
  467.                 item := EMcut;
  468.             copyKey: 
  469.                 item := EMcopy;
  470.             pasteKey: 
  471.                 item := EMpaste;
  472.             clearKey: 
  473.                 item := EMclear;
  474.             otherwise
  475.                 item := -1;
  476.         end;
  477.         if item <> -1 then begin
  478.             SetFMenus;
  479.             if not GetIDItemEnable(M_Edit, 0) or not GetIDItemEnable(M_Edit, item) then
  480.                 item := -1;
  481.         end;
  482.         if item = -1 then
  483.             DoKey(modifiers, ch, code)
  484.         else
  485.             DoMenu(M_Edit, item, domenup);
  486.     end;
  487.  
  488.     procedure WObject.DoAutoKey (modifiers: integer; ch: char; code: integer);
  489.     begin
  490.     end;
  491.  
  492.     procedure WObject.DoDrag (where: point);
  493.         var
  494.             temprect: rect;
  495.             bnds1, bnds2: point;
  496.     begin
  497.         tempRect := GetGrayRgn^^.rgnBBox;
  498.         bnds1 := window^.portBits.bounds.topleft;
  499.         DragWindow(window, where, tempRect);
  500.         bnds2 := window^.portBits.bounds.topleft;
  501.         OffsetRect(WStateDataHandle(WindowPeek(window)^.dataHandle)^^.stdState, bnds1.h - bnds2.h, bnds1.v - bnds2.v);
  502.     end;
  503.  
  504.     procedure WObject.DoGrow (where: point);
  505.         var
  506.             mypt: point;
  507.             oldrect: rect;
  508.             mResult: longInt;
  509.             tempRect: rect;
  510.     begin
  511.         SetPort(window);
  512.         myPt := where;
  513.         GlobalToLocal(myPt);
  514.         oldrect := window^.portRect;
  515.         mResult := GrowWindow(window, where, growRect);
  516.         SizeWindow(window, LoWord(mResult), HiWord(mResult), TRUE);
  517.         SetRect(tempRect, 0, myPt.v - 15, myPt.h + 15, myPt.v + 15);
  518.         EraseRect(tempRect);
  519.         InvalRect(tempRect);
  520.         SetRect(tempRect, myPt.h - 15, 0, myPt.h + 15, myPt.v + 15);
  521.         EraseRect(tempRect);
  522.         InvalRect(tempRect);
  523.         Resize;
  524.     end;
  525.  
  526.     procedure WObject.Zoom (code: integer);
  527.         var
  528.             globalPortRect, theSect, zoomRect: Rect;
  529.             nthDevice, dominantGDevice: GDHandle;
  530.             sectFlag: boolean;
  531.             bias: integer;
  532.             greatestArea, sectArea: longInt;
  533.             tl, br: point;
  534.     begin
  535.         SetPort(window);
  536.         EraseRect(window^.portRect);    {recommended for cosmetic reasons}
  537.         if (code = inZoomOut) then begin
  538.             if sysenv.hasColorQD then begin
  539.                 globalPortRect := window^.portRect;
  540.                 LocalToGlobal(globalPortRect.topLeft);
  541.                 LocalToGlobal(globalPortRect.botRight);
  542.           { must calculate height of window's title bar }
  543.         { bias := globalPortRect.top - 1 - WindowPeek(window)^.strucRgn^^.rgnBBox.top; }
  544.         {   This doesn't work if the window is invisible, because structRgn is empty, and thus rgnBBox is 0,0,0,0 }
  545.                 bias := titlebar_hight;
  546.                 nthDevice := GetDeviceList;
  547.                 greatestArea := -1;
  548.           { This loop checks the window against all the gdRects in the   }
  549.           { gDevice list and remembers which gdRect contains the largest }
  550.           { portion of the window being zoomed. }
  551.                 while nthDevice <> nil do begin
  552.                     sectFlag := SectRect(globalPortRect, nthDevice^^.gdRect, theSect);
  553.                     with theSect do
  554.                         sectArea := LONGINT(right - left) * (bottom - top);
  555.                     if sectArea > greatestArea then begin
  556.                         greatestArea := sectArea;
  557.                         dominantGDevice := nthDevice;
  558.                     end;
  559.                     nthDevice := GetNextDevice(nthDevice);
  560.                 end; {of WHILE}
  561.           { We must create a zoom rectangle manually in this case. }
  562.           { account for menu bar height as well, if on main device }
  563.                 if dominantGDevice = GetMainDevice then
  564.                     bias := bias + GetMBarHeight;
  565.                 with dominantGDevice^^.gdRect do
  566.                     SetRect(zoomRect, left + 3, top + bias + 3, right - 3, bottom - 3);
  567.             end {of Color QuickDraw conditional stuff}
  568.             else begin
  569.                 zoomRect := WStateDataHandle(WindowPeek(window)^.dataHandle)^^.stdState;
  570.             end;
  571.             tl := window^.portRect.topleft;
  572.             LocalToGlobal(tl);
  573.             br.v := tl.v + zoomSize.v;
  574.             br.h := tl.h + zoomSize.h;
  575.             with zoomRect do begin
  576.                 if PtInRect(tl, zoomRect) and PtInRect(br, zoomRect) then begin
  577.                     zoomRect.topleft := tl;
  578.                     zoomRect.botright := br;
  579.                 end
  580.                 else begin
  581.                     if right - left > zoomSize.h then
  582.                         right := left + zoomSize.h;
  583.                     if bottom - top > zoomSize.v then
  584.                         bottom := top + zoomSize.v;
  585.                 end;
  586.             end;
  587.        { Set up the WStateData record for this window. }
  588.             WStateDataHandle(WindowPeek(window)^.dataHandle)^^.stdState := zoomRect;
  589.         end;
  590.         ZoomWindow(window, code, true);
  591.         Resize;
  592.     end;
  593.  
  594.     procedure WObject.DoZoom (where: point; code: integer);
  595.     begin
  596.         SetPort(window);
  597.         if TrackBox(window, where, code) then
  598.             Zoom(code);
  599.     end;
  600.  
  601.     procedure WObject.DoGoAway (where: point);
  602.     begin
  603.         if TrackGoAway(window, where) then
  604.             DoClose;
  605.     end;
  606.  
  607.     procedure WObject.DoUpdate;
  608.     begin
  609.         BeginUpdate(window);
  610.         Draw;
  611.         EndUpdate(window);
  612.     end;
  613.  
  614.     procedure WObject.DoMouseMoved (where: point);
  615.     begin
  616.     end;
  617.  
  618.     procedure WObject.DoActivateDeactivate (activate: boolean);
  619.     begin
  620.         Assert(window <> nil);
  621.         is_active := activate and windowPeek(window)^.visible;
  622.         if is_active then
  623.             SelectWindow(window);
  624.         if draw_grow_icon then
  625.             DrawGrowIcon(window);
  626.     end;
  627.  
  628.     procedure WObject.Resize;
  629.     begin
  630.         if draw_grow_icon then
  631.             DrawGrowIcon(window);
  632.     end;
  633.  
  634.     procedure WObject.Draw;
  635.     begin
  636.         if draw_grow_icon then
  637.             DrawGrowIcon(window);
  638.     end;
  639.  
  640.     function WObject.DoIsDialogEvent (er: eventRecord): boolean;
  641.     begin
  642.         DoIsDialogEvent := IsDialogEvent(er);
  643.     end;
  644.  
  645.     function WObject.DoDialogSelect (er: eventRecord; var dlg: dialogPtr; var item: integer): boolean;
  646.     begin
  647.         DoDialogSelect := DialogSelect(er, dlg, item);
  648.     end;
  649.  
  650.     procedure WObject.DoIdle;
  651.     begin
  652.     end;
  653.  
  654.     function WObject.DoMainClick (er: eventRecord): boolean;
  655.         var
  656.             b: boolean;
  657.             wp: windowPtr;
  658.             mResult: longInt;
  659.             code: integer;
  660.     begin
  661.         b := false;
  662.         code := FindWindow(er.where, wp);
  663.         if (wp <> nil) and (wp <> window) then begin
  664.             if (BAND(er.modifiers, cmdKey) = 0) or (code <> inDrag) then
  665.                 SelectWindow(wp);
  666.             if code = inDrag then
  667.                 GetWObject(wp).DoDrag(er.where);
  668.         end
  669.         else
  670.             case code of
  671.                 inMenuBar:  begin
  672.                     SetFMenus;
  673.                     mResult := MenuSelect(er.where);
  674.                     if mResult <> 0 then
  675.                         DoMenu(HiWord(mResult), LoWord(mResult), domenup);
  676.                 end;
  677.                 InDrag: 
  678.                     DoDrag(er.where);
  679.                 inGrow: 
  680.                     DoGrow(er.where);
  681.                 inZoomIn, inZoomOut: 
  682.                     DoZoom(er.where, code);
  683.                 inGoAway: 
  684.                     DoGoAway(er.where);
  685.                 inContent:  begin
  686.                     GlobalToLocal(er.where);
  687.                     DoContent(er.where);
  688.                 end;
  689.                 inSysWindow: 
  690.                     SystemClick(er, window);
  691.                 otherwise
  692.                     b := true;
  693.             end;
  694.         DoMainClick := b;
  695.     end;
  696.  
  697.     function WObject.HandleEvents (er: eventRecord): boolean;
  698.         var
  699.             wp: windowPtr;
  700.             b: boolean;
  701.             obj: WObject;
  702.             code: integer;
  703.             mResult: longInt;
  704.             myPt: point;
  705.             temprect: rect;
  706.             ch: char;
  707.             dlg: dialogPtr;
  708.             item: integer;
  709.     begin
  710.         DoIdle;
  711.         b := true;
  712.         if DoIsDialogEvent(er) then begin
  713.             if DoDialogSelect(er, dlg, item) then begin
  714.                 GetDObject(dlg).DoItemWhere(er, item);
  715.                 b := false;
  716.             end;
  717.         end;
  718.         if b then begin
  719.             b := false;
  720.             case er.what of
  721.                 MouseDown: 
  722.                     b := DoMainClick(er);
  723.  
  724.                 KeyDown:  begin
  725.                     ch := chr(BAND(er.message, CharCodeMask));
  726.                     mResult := 0;
  727.                     if BAND(er.modifiers, CmdKey) <> 0 then begin
  728.                         SetFMenus;
  729.                         mResult := DoMenuKey(er, ch);
  730.                     end;
  731.                     if mResult <> 0 then
  732.                         DoMenu(HiWord(mResult), LoWord(mResult), domenup)
  733.                     else
  734.                         DoSpecialKey(er.modifiers, ch, BAND(er.message, keyCodeMask) div $100);
  735.                 end;
  736.  
  737.                 AutoKey: 
  738.                     DoAutoKey(er.modifiers, chr(BAND(er.message, CharCodeMask)), BAND(er.message, keyCodeMask) div $100);
  739.  
  740.                 UpdateEvt: 
  741.                     GetWObject(windowPtr(er.message)).DoUpdate;
  742.  
  743.                 ActivateEvt: 
  744.                     GetWObject(windowPtr(er.message)).DoActivateDeactivate(odd(er.modifiers));
  745.  
  746.                 kOSEvent: 
  747.                     if BAND(BROTL(er.message, 8), $FF) = kSuspendResumeMessage then
  748.                         DoSuspendResume(BAnd(er.message, kResumeMask) <> 0)
  749.                     else if BAND(BROTL(er.message, 8), $FF) = kMouseMovedMessage then
  750.                         DoMouseMoved(er.where)
  751.                     else
  752.                         b := true;
  753.  
  754.                 kHighLevelEvent: 
  755.                     DoHighLevel(er);
  756.  
  757.                 DiskEvt: 
  758.                     DoDiskEvent(er.message);
  759.  
  760.                 otherwise
  761.                     b := true;
  762.             end;
  763.         end;
  764.         HandleEvents := b;
  765.     end;
  766.  
  767.     procedure DObject.Create (id: integer);
  768.         var
  769.             wp: myDialogPtr;
  770.     begin
  771.         wp := myDialogPtr(NewPtr(SizeOf(myDialogRecord)));
  772.         wp^.magic := OOMagic;
  773.         window := GetNewDialog(id, ptr(wp), POINTER(-1));
  774.         ok_item := 0;
  775.         cancel_item := 0;
  776.         handle_activate_outline := false;
  777.         JointCreate(self, id);
  778.     end;
  779.  
  780.     procedure DObject.Destroy;
  781.     begin
  782.         if window <> nil then
  783.             DisposDialog(window);
  784.         if self <> default_object then
  785.             dispose(self);
  786.     end;
  787.  
  788.     procedure OODrawOutline (dp: dialogPtr; item: integer);
  789.         var
  790.             r: rect;
  791.             fi: DObject;
  792.     begin
  793.         SetPort(dp);
  794.         fi := DObject(GetWObject(dp));
  795.         GetDItemRect(dp, fi.ok_item, r);
  796.         InsetRect(r, -4, -4);
  797.         PenSize(3, 3);
  798.         if not ControlEnabled(dp, fi.ok_item) or not fi.is_active then begin
  799.             PenPat(gray);
  800.             FrameRoundRect(r, 16, 16);
  801.             PenPat(black);
  802.         end
  803.         else
  804.             FrameRoundRect(r, 16, 16);
  805.     end;
  806.  
  807.     procedure DObject.SetOOOutline (def_item, user_item: integer);
  808.         var
  809.             kind: integer;
  810.             h: handle;
  811.             r: rect;
  812.     begin
  813.         handle_activate_outline := true;
  814.         ok_item := def_item;
  815.         GetDItem(window, user_item, kind, h, r);
  816.         InsetRect(r, -10, -10);
  817.         SetDItem(window, user_item, userItem, handle(@OODrawOutline), r);
  818.     end;
  819.  
  820.     procedure DObject.DoActivateDeactivate (activate: boolean);
  821.     begin
  822.         inherited DoActivateDeactivate(activate);
  823.         if handle_activate_outline then
  824.             OODrawOutline(window, 0);
  825.     end;
  826.  
  827.     procedure DObject.DoOK (modifiers: integer; ch: char; code: integer);
  828.     begin
  829.         if ok_item = 0 then
  830.             DoKey(modifiers, ch, code)
  831.         else begin
  832.             if ControlEnabled(window, ok_item) then begin
  833.                 FlashItem(window, ok_Item);
  834.                 DoItem(ok_item);
  835.             end;
  836.         end;
  837.     end;
  838.  
  839.     procedure DObject.DoCancel (modifiers: integer; ch: char; code: integer);
  840.     begin
  841.         if cancel_item = 0 then
  842.             DoKey(modifiers, ch, code)
  843.         else begin
  844.             FlashItem(window, cancel_Item);
  845.             DoItem(cancel_item);
  846.         end;
  847.     end;
  848.  
  849.     procedure DObject.DoItem (item: integer);
  850.     begin
  851.     end;
  852.  
  853.     procedure DObject.DoItemWhere (er: eventRecord; item: integer);
  854.     begin
  855.         DoItem(item);
  856.     end;
  857.  
  858.     function DObject.HandleEvents (er: eventRecord): boolean;
  859.         var
  860.             b: boolean;
  861.             ch: char;
  862.     begin
  863.         b := true;
  864.         if ((er.what = KeyDown) or (er.what = AutoKey)) then begin
  865.             b := false;
  866.             ch := chr(BAND(er.message, charCodeMask));
  867.             if (ch = chr(13)) or (ch = chr(3)) then
  868.                 DoOK(er.modifiers, ch, BAND(er.message, keyCodeMask) div $100)
  869.             else if (ch = chr(27)) or ((ch = '.') and (BAND(er.modifiers, cmdKey) <> 0)) then
  870.                 DoCancel(er.modifiers, ch, BAND(er.message, keyCodeMask) div $100)
  871.             else
  872.                 b := true;
  873.         end;
  874.         if b then
  875.             b := inherited HandleEvents(er);
  876.         HandleEvents := b;
  877.     end;
  878.  
  879.     procedure DTObject.SetEditMenuItem (item: integer);
  880.     begin
  881.         TESetEditMenuItem(dialogPeek(window)^.textH, false, 250, item);
  882.     end;
  883.  
  884.     function DTObject.EditMenuEnabled: boolean;
  885.     begin
  886.         EditMenuEnabled := TEEditMenuEnabled(dialogPeek(window)^.textH, false, 250);
  887.     end;
  888.  
  889.     procedure DTObject.DoEditMenu (item: integer);
  890.         var
  891.             modified: boolean;
  892.     begin
  893.         modified := TEDoEditMenu(dialogPeek(window)^.textH, false, 250, item);
  894.     end;
  895.  
  896.     function DTObject.DoIsDialogEvent (er: eventRecord): boolean;
  897.     begin
  898.         if ((er.what = keyDown) or (er.what = autoKey)) and (BAND(er.modifiers, cmdKey) <> 0) then begin
  899.             DoIsDialogEvent := false; { Stop system 7 from doing the edit menu as well }
  900.         end
  901.         else
  902.             DoIsDialogEvent := inherited DoIsDialogevent(er);
  903.     end;
  904.  
  905. end.